From 2f4c5d8609cc31bb7212126dcaf45dd55d21880a Mon Sep 17 00:00:00 2001 From: justbur Date: Mon, 30 Nov 2015 11:23:50 -0500 Subject: [PATCH] Use key-description for canonical keys This takes the idea in the previous commit and translates the representations of keys in the alists to be the output of key-description. The issue is that `M-x` for example has two representations with listify-key-sequence, but only one (it seems) from key-description. --- which-key.el | 138 +++++++++++++++++++++++++-------------------------- 1 file changed, 69 insertions(+), 69 deletions(-) diff --git a/which-key.el b/which-key.el index fc82da92e90..b72de6f545c 100644 --- a/which-key.el +++ b/which-key.el @@ -400,15 +400,15 @@ variable.") (defvar which-key-prefix-name-alist '() "An alist with elements of the form (key-sequence . prefix-name). -key-sequence is a sequence of the sort produced by applying `kbd' -then `listify-key-sequence' to create a canonical version of the -key sequence. prefix-name is a string.") +key-sequence is a sequence of the sort produced by applying +`key-description' to create a canonical version of the key +sequence. prefix-name is a string.") (defvar which-key-prefix-title-alist '() "An alist with elements of the form (key-sequence . prefix-title). -key-sequence is a sequence of the sort produced by applying `kbd' -then `listify-key-sequence' to create a canonical version of the -key sequence. prefix-title is a string. The title is displayed +key-sequence is a sequence of the sort produced by applying +`key-description' to create a canonical version of the key +sequence. prefix-title is a string. The title is displayed alongside the actual current key sequence when `which-key-show-prefix' is set to either top or echo.") @@ -470,7 +470,7 @@ set too high) and setup which-key buffer." (when (or (eq which-key-show-prefix 'echo) (eq which-key-popup-type 'minibuffer)) (which-key--setup-echo-keystrokes)) - (which-key--check-key-based-alist) + ;; (which-key--check-key-based-alist) ;; (which-key--setup-undo-key) (which-key--init-buffer) (setq which-key--is-setup t)) @@ -509,35 +509,35 @@ starter kit for example." ;; (which-key-define-key-recursively ;; map (kbd which-key-undo-key) 'which-key-undo)))) -(defun which-key--check-key-based-alist () - "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" - (let ((alist which-key-key-based-description-replacement-alist) - old-style res) - (dolist (cns alist) - (cond ((listp (car cns)) - (push cns res)) - ((stringp (car cns)) - (setq old-style t) - (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res)) - ((symbolp (car cns)) - (let (new-mode-alist) - (dolist (cns2 (cdr cns)) - (cond ((listp (car cns2)) - (push cns2 new-mode-alist)) - ((stringp (car cns2)) - (setq old-style t) - (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2)) - new-mode-alist)))) - (push (cons (car cns) new-mode-alist) res))) - (t (message "which-key: there's a problem with the \ -entry %s in which-key-key-based-replacement-alist" cns)))) - (setq which-key-key-based-description-replacement-alist res) - (when old-style - (message "which-key: \ - `which-key-key-based-description-replacement-alist' has changed format and you\ - seem to be using the old format. Please use the functions \ -`which-key-add-key-based-replacements' and \ -`which-key-add-major-mode-key-based-replacements' instead.")))) +;; (defun which-key--check-key-based-alist () +;; "Check (and fix if necessary) `which-key-key-based-description-replacement-alist'" +;; (let ((alist which-key-key-based-description-replacement-alist) +;; old-style res) +;; (dolist (cns alist) +;; (cond ((listp (car cns)) +;; (push cns res)) +;; ((stringp (car cns)) +;; (setq old-style t) +;; (push (cons (listify-key-sequence (kbd (car cns))) (cdr cns)) res)) +;; ((symbolp (car cns)) +;; (let (new-mode-alist) +;; (dolist (cns2 (cdr cns)) +;; (cond ((listp (car cns2)) +;; (push cns2 new-mode-alist)) +;; ((stringp (car cns2)) +;; (setq old-style t) +;; (push (cons (listify-key-sequence (kbd (car cns2))) (cdr cns2)) +;; new-mode-alist)))) +;; (push (cons (car cns) new-mode-alist) res))) +;; (t (message "which-key: there's a problem with the \ +;; entry %s in which-key-key-based-replacement-alist" cns)))) +;; (setq which-key-key-based-description-replacement-alist res) +;; (when old-style +;; (message "which-key: \ +;; `which-key-key-based-description-replacement-alist' has changed format and you\ +;; seem to be using the old format. Please use the functions \ +;; `which-key-add-key-based-replacements' and \ +;; `which-key-add-major-mode-key-based-replacements' instead.")))) ;; Default configuration functions for use by users. Should be the "best" ;; configurations @@ -584,15 +584,15 @@ bottom." (when (or (not (stringp key)) (not (stringp value))) (error "which-key: Error %s (key) and %s (value) should be strings" key value)) - (let ((key-lst (listify-key-sequence (kbd key)))) - (cond ((null alist) (list (cons key-lst value))) - ((assoc key-lst alist) - (when (not (string-equal (cdr (assoc key-lst alist)) value)) + (let ((keys (key-description (kbd key)))) + (cond ((null alist) (list (cons keys value))) + ((assoc-string keys alist) + (when (not (string-equal (cdr (assoc-string keys alist)) value)) (message "which-key: changing %s name from %s to %s in the %s alist" - key (cdr (assoc key-lst alist)) value alist-name) - (setcdr (assoc key-lst alist) value)) + key (cdr (assoc-string keys alist)) value alist-name) + (setcdr (assoc-string keys alist) value)) alist) - (t (cons (cons key-lst value) alist))))) + (t (cons (cons keys value) alist))))) ;;;###autoload (defun which-key-add-key-based-replacements (key-sequence replacement &rest more) @@ -641,11 +641,11 @@ Add title for KEY-SEQ-STR given by TITLE. FORCE, if non-nil, will add the new title even if one already exists. KEY-SEQ-STR should be a key sequence string suitable for `kbd' and TITLE should be a string." - (let ((key-seq-lst (listify-key-sequence (kbd key-seq-str)))) + (let ((keys (key-description (kbd key-seq-str)))) (if (and (null force) - (assoc key-seq-lst which-key-prefix-title-alist)) + (assoc-string keys which-key-prefix-title-alist)) (message "which-key: Prefix title not added. A title exists for this prefix.") - (push (cons key-seq-lst title) which-key-prefix-title-alist)))) + (push (cons keys title) which-key-prefix-title-alist)))) ;;;###autoload (defun which-key-declare-prefixes (key-sequence name &rest more) @@ -1103,30 +1103,31 @@ replacement occurs return the new STRING." (when key-str (listify-key-sequence (kbd key-str)))))) -(defun which-key--maybe-replace-prefix-name (key-lst desc) - "KEY-LST is a list of keys produced by `listify-key-sequences' -and DESC is the description that is possibly replaced using the -`which-key-prefix-name-alist'. Whether or not a replacement -occurs return the new STRING." +(defun which-key--maybe-replace-prefix-name (keys desc) + "KEYS is a list of keys produced by `listify-key-sequences' and +`key-description'. DESC is the description that is possibly +replaced using the `which-key-prefix-name-alist'. Whether or not +a replacement occurs return the new STRING." (let* ((alist which-key-prefix-name-alist) - (canonical-key-lst (listify-key-sequence (kbd (key-description key-lst)))) - (res (assoc canonical-key-lst alist)) + (res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc canonical-key-lst mode-alist)))) + (mode-res (when mode-alist + (assoc-string keys mode-alist)))) (cond (mode-res (cdr mode-res)) (res (cdr res)) (t desc)))) -(defun which-key--maybe-get-prefix-title (key-lst) - "KEY-LST is a list of keys produced by `listify-key-sequences'. +(defun which-key--maybe-get-prefix-title (keys) + "KEYS is a string produced by `key-description'. A title is possibly returned using `which-key-prefix-title-alist'. An empty stiring is returned if no title exists." - (if key-lst + (if keys (let* ((alist which-key-prefix-title-alist) - (res (assoc key-lst alist)) + (res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc key-lst mode-alist))) - (binding (key-binding (apply #'vector key-lst))) + (mode-res (when mode-alist + (assoc-string keys mode-alist))) + (binding (key-binding keys)) (alternate (when (and binding (symbolp binding)) (symbol-name binding)))) (cond (mode-res (cdr mode-res)) @@ -1137,19 +1138,19 @@ An empty stiring is returned if no title exists." (eq which-key-side-window-location 'bottom) echo-keystrokes) (if alternate alternate - (concat "Following " (key-description key-lst)))) + (concat "Following " keys))) (t ""))) "Top-level bindings")) -(defun which-key--maybe-replace-key-based (string key-lst) - "KEY-LST is a list of keys produced by `listify-key-sequences' +(defun which-key--maybe-replace-key-based (string keys) + "KEYS is a string produced by `key-description' and STRING is the description that is possibly replaced using the `which-key-key-based-description-replacement-alist'. Whether or not a replacement occurs return the new STRING." (let* ((alist which-key-key-based-description-replacement-alist) - (str-res (assoc key-lst alist)) + (str-res (assoc-string keys alist)) (mode-alist (assq major-mode alist)) - (mode-res (when mode-alist (assoc key-lst mode-alist)))) + (mode-res (when mode-alist (assoc-string keys mode-alist)))) (cond (mode-res (cdr mode-res)) (str-res (cdr str-res)) (t string)))) @@ -1246,7 +1247,6 @@ alists. Returns a list (key separator description)." (orig-desc (cdr key-desc-cons)) (group (which-key--group-p orig-desc)) (keys (which-key--current-key-string key)) - (key-lst (which-key--current-key-list key)) (local (eq (which-key--safe-lookup-key local-map (kbd keys)) (intern orig-desc))) (hl-face (which-key--highlight-face orig-desc)) @@ -1254,9 +1254,9 @@ alists. Returns a list (key separator description)." key which-key-key-replacement-alist)) (desc (which-key--maybe-replace orig-desc which-key-description-replacement-alist)) - (desc (which-key--maybe-replace-key-based desc key-lst)) + (desc (which-key--maybe-replace-key-based desc keys)) (desc (if group - (which-key--maybe-replace-prefix-name key-lst desc) + (which-key--maybe-replace-prefix-name keys desc) desc)) (key-w-face (which-key--propertize-key key)) (desc-w-face (which-key--propertize-description @@ -1520,7 +1520,7 @@ enough space based on your settings and frame size." prefix-keys) (status-left (propertize (format "%s/%s" (1+ page-n) n-pages) 'face 'which-key-separator-face)) (status-top (propertize (which-key--maybe-get-prefix-title - (which-key--current-key-list)) + (which-key--current-key-string)) 'face 'which-key-note-face)) (status-top (concat status-top (when (< 1 n-pages) -- 2.30.2